perm filename CYCXGP.LAP[3,LMM] blob sn#037508 filedate 1973-04-22 generic text, type T, neo UTF8
(DEFPROP CYCXGPFNS (CYCXGPFNS (SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON))) (SAVDEF (QUOTE (APT AIV→
ECT AVECT LABELL INITDRAW ENDDRAW))) APT AIVECT AVECT MOVBITS SELFONT SETFONT PRINCMAKNUM MAKNUM LOGAND LABELL I→
NITDRAW ENDDRAW CLOSEXGP (SETQ XGPOUT NIL) (SETQ REALBOTTOM 1.) (SETQ REALEFT -511.) (SETQ REALHEIGHT (SETQ REAL→
WIDTH 512.)) (SETQ EPSILON 0.5)) VALUE) 

(SAVVALUE (QUOTE (REALBOTTOM REALEFT REALHEIGHT EPSILON))) 

(SAVDEF (QUOTE (APT AIVECT AVECT LABELL INITDRAW ENDDRAW))) 

(LAP APT SUBR) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE /␈) S) 
       (PUSH P 2.) 
       (CALL 1. (E PRINC) S) 
       (MOVEI 1. (QUOTE "P") S) 
       (CALL 1. (E PRINC) S) 
       (EXCH 1. -1. P) 
       (CALL 1. (E PRINCMAKNUM) S) 
       (POP P 1.) 
       (SUB P (C 1. 0. 1. 0.)) 
       (JCALL 1. (E PRINCMAKNUM) S) 
       NIL 

(LAP AIVECT SUBR) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE /␈) S) 
       (PUSH P 2.) 
       (CALL 1. (E PRINC) S) 
       (MOVEI 1. (QUOTE "I") S) 
       (CALL 1. (E PRINC) S) 
       (EXCH 1. -1. P) 
       (CALL 1. (E PRINCMAKNUM) S) 
       (POP P 1.) 
       (SUB P (C 1. 0. 1. 0.)) 
       (JCALL 1. (E PRINCMAKNUM) S) 
       NIL 

(LAP AVECT SUBR) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE /␈) S) 
       (PUSH P 2.) 
       (CALL 1. (E PRINC) S) 
       (MOVEI 1. (QUOTE "V") S) 
       (CALL 1. (E PRINC) S) 
       (EXCH 1. -1. P) 
       (CALL 1. (E PRINCMAKNUM) S) 
       (POP P 1.) 
       (SUB P (C 1. 0. 1. 0.)) 
       (JCALL 1. (E PRINCMAKNUM) S) 
       NIL 

(LAP MOVBITS SUBR) 
       (PUSH P 1.) 
       (CALL 1. (E MINUSP) S) 
       (JUMPE 1. TAG2) 
       (MOVEI 1. (QUOTE /␈) S) 
       (CALL 1. (E PRINC) S) 
       (MOVEI 1. (QUOTE /␈) S) 
       (CALL 1. (E PRINC) S) 
       (MOVE 1. 0. P) 
       (CALL 1. (E MINUS) S) 
       (CALL 1. (E ASCII) S) 
       (CALL 1. (E PRINC) S) 
       (JRST 0. TAG1) 
 TAG2  (MOVEI 1. (QUOTE /␈) S) 
       (CALL 1. (E PRINC) S) 
       (MOVEI 1. (QUOTE " ") S) 
       (CALL 1. (E PRINC) S) 
       (MOVE 1. 0. P) 
       (CALL 1. (E ASCII) S) 
       (CALL 1. (E PRINC) S) 
 TAG1  (SUB P (C 1. 0. 1. 0.)) 
       (POPJ P) 
       NIL 

(LAP SELFONT SUBR) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE /␈) S) 
       (CALL 1. (E PRINC) S) 
       (POP P 1.) 
       (JCALL 1. (E PRINC) S) 
       NIL 

(LAP SETFONT SUBR) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE /␈) S) 
       (PUSH P 2.) 
       (CALL 1. (E PRINC) S) 
       (MOVE 1. (SPECIAL λ) S) 
       (CALL 1. (E PRINC) S) 
       (EXCH 1. -1. P) 
       (CALL 1. (E PRINC) S) 
       (MOVE 1. (SPECIAL PP) S) 
       (CALL 1. (E PRINC) S) 
       (POP P 1.) 
       (CALL 1. (E PRINC) S) 
       (POP P 1.) 
       (POPJ P) 
       NIL 

(LAP PRINCMAKNUM SUBR) 
       (MOVEI 2. (QUOTE 130.)) 
       (PUSH P 1.) 
       (CALL 2. (E *QUO) S) 
       (MOVEI 2. (QUOTE 64.)) 
       (CALL 2. (E *PLUS) S) 
       (CALL 1. (E TYO) S) 
       (MOVEI 2. (QUOTE 127.)) 
       (POP P 1.) 
       (CALL 2. (E LOGAND) S) 
       (JCALL 1. (E TYO) S) 
       NIL 

(LAP MAKNUM SUBR) 
       (MOVEI 2. (QUOTE 130.)) 
       (PUSH P 1.) 
       (CALL 2. (E *QUO) S) 
       (MOVEI 2. (QUOTE 64.)) 
       (CALL 2. (E *PLUS) S) 
       (CALL 1. (E ASCII) S) 
       (MOVEI 2. (QUOTE 127.)) 
       (EXCH 1. 0. P) 
       (CALL 2. (E LOGAND) S) 
       (CALL 1. (E ASCII) S) 
       (CALL 1. (E NCONS) S) 
       (POP P 2.) 
       (CALL 2. (E XCONS) S) 
       (JCALL 1. (E READLIST) S) 
       NIL 

(LAP LOGAND SUBR) 
       (PUSH P 1.) 
       (PUSH P 2.) 
       (PUSH P (C 0. 0. TAG1 0.)) 
       (PUSH P (C 0. 0. (QUOTE 1.) 0.)) 
       (PUSH P 1.) 
       (PUSH P 2.) 
       (MOVNI 6. 3.) 
       (JCALL 14. (E BOOLE) S) 
 TAG1  (SUB P (C 2. 0. 2. 0.)) 
       (POPJ P) 
       NIL 

(LAP LABELL SUBR) 
       (JCALL 1. (E PRINC) S) 
       NIL 

(DEFPROP LABELL (NIL (3. . C) (2. . C) (6. . CO) (4. . C) (5. . C) (1. . C)) VALUE) 

(LAP INITDRAW SUBR) 
       (MOVE 1. (SPECIAL XGPOUT) S) 
       (JUMPN 1. TAG1) 
       (CALL 0. (E TERPRI) S) 
       (MOVEI 1. (QUOTE "XGP OUTPUT FILE?") S) 
       (CALL 1. (E PRINC) S) 
       (CALL 0. (E READ) S) 
       (CALL 1. (E NCONS) S) 
       (MOVEI 2. (QUOTE DSK:) S) 
       (CALL 2. (E XCONS) S) 
       (MOVEI 2. (QUOTE XGPOUT) S) 
       (CALL 2. (E XCONS) S) 
       (CALL 15. (E OUTPUT) S) 
       (MOVEM 1. (SPECIAL XGPOUT) S) 
 TAG1  (CALL 1. (E OUTC) S) 
       (MOVEI 1. (QUOTE 10000.)) 
       (CALL 1. (E LINELENGTH) S) 
       (MOVEI 1. (QUOTE 512.)) 
       (MOVEM 1. (SPECIAL REALHEIGHT) S) 
       (MOVEM 1. (SPECIAL REALWIDTH) S) 
       (MOVE 2. (SPECIAL REALEFT) S) 
       (MOVEI 1. (QUOTE 512.)) 
       (CALL 2. (E *PLUS) S) 
       (MOVEM 1. (SPECIAL REALEFT) S) 
       (MOVEI 2. (QUOTE 1024.)) 
       (CALL 2. (E *LESS) S) 
       (JUMPN 1. TAG2) 
       (MOVEI 1. (QUOTE 1.)) 
       (MOVEM 1. (SPECIAL REALEFT) S) 
       (MOVE 2. (SPECIAL REALBOTTOM) S) 
       (MOVEI 1. (QUOTE 512.)) 
       (CALL 2. (E *PLUS) S) 
       (MOVEM 1. (SPECIAL REALBOTTOM) S) 
       (MOVEI 2. (QUOTE 1536.)) 
       (CALL 2. (E *LESS) S) 
       (JUMPN 1. TAG2) 
       (MOVEI 1. (QUOTE 1.)) 
       (MOVEM 1. (SPECIAL REALBOTTOM) S) 
       (CALL 0. (E TERPRI) S) 
       (PUSH P 1.) 
       (MOVEI 1. (QUOTE "") S) 
       (CALL 1. (E PRINC) S) 
       (POP P 1.) 
       (JUMPN 1. TAG2) 
       (TDZA 1. 1.) 
 TAG2  (MOVEI 1. (QUOTE T) S) 
       (POPJ P) 
       NIL 

(LAP ENDDRAW SUBR) 
       (MOVEI 1. (QUOTE 72.)) 
       (CALL 1. (E LINELENGTH) S) 
       (MOVEI 2. (QUOTE NIL)) 
       (MOVEI 1. (QUOTE NIL)) 
       (JCALL 2. (E OUTC) S) 
       NIL 

(LAP CLOSEXGP SUBR) 
       (MOVEI 1. (QUOTE -511.)) 
       (MOVEM 1. (SPECIAL REALEFT) S) 
       (MOVEI 1. (QUOTE 1.)) 
       (MOVEM 1. (SPECIAL REALBOTTOM) S) 
       (PUSH P 1.) 
       (PUSH P 1.) 
       (PUSH P 1.) 
       (PUSH P 1.) 
       (MOVE 1. (SPECIAL XGPOUT) S) 
       (JUMPE 1. TAG2) 
       (CLEARM 0. (SPECIAL XGPOUT) S) 
       (MOVEI 2. (QUOTE NIL)) 
       (MOVEI 1. (QUOTE XGPOUT) S) 
       (CALL 2. (E OUTC) S) 
       (MOVEI 2. (QUOTE T) S) 
       (MOVEM 1. -3. P) 
       (MOVEI 1. (QUOTE NIL)) 
       (CALL 2. (E OUTC) S) 
       (EXCH 1. -3. P) 
       (JUMPN 1. TAG1) 
 TAG2 
 TAG1  (MOVE 1. 0. P) 
       (SUB P (C 4. 0. 4. 0.)) 
       (POPJ P) 
       NIL 

(SETQ XGPOUT NIL) 

(SETQ REALBOTTOM 1.) 

(SETQ REALEFT -511.) 

(SETQ REALHEIGHT (SETQ REALWIDTH 512.)) 

(SETQ EPSILON 0.5)